C---------------------------------------------------------
C    TOOLPACK/1    Release: 3.1
C---------------------------------------------------------
C
C  TOKEN STREAM BASED 'CLUGGE' PROGRAM!
C  CHANGES FORMAT OF REAL NUMBERS..........
C
      PROGRAM ISTFR
 
      INTEGER TKNIN, TKNOUT, CMTIN, CMTOUT
      INTEGER TKNINM(81), TKNONM(81),
     +        CMTINM(81), CMTONM(81)
 
      INTEGER OPEN, CREATE, GETARG, READCF
 
C  Read paths from command file
 
      CALL ZINIT
 
      IF (GETARG(1,TKNINM,81).EQ.-100) CALL NAMES(1,TKNINM)
      IF (GETARG(2,CMTINM,81).EQ.-100) CALL NAMES(2,CMTINM)
      IF (GETARG(3,TKNONM,81).EQ.-100) CALL NAMES(3,TKNONM)
      IF (GETARG(4,CMTONM,81).EQ.-100) CALL NAMES(4,CMTONM)
C       Open required files
 
      TKNIN =OPEN(TKNINM,0)
      IF (TKNIN .EQ.-1)
     +      CALL ERROR('ISTFR unable to open input token file.')
      CMTIN =OPEN(CMTINM,0)
      IF (CMTIN .EQ.-1)
     +      CALL ERROR('ISTFR unable to open input comment file.')
      TKNOUT=CREATE(TKNONM,1)
      IF (TKNOUT.EQ.-1)
     +      CALL ERROR('ISTFR unable to open output token file.')
      CMTOUT=CREATE(CMTONM,1)
      IF (CMTOUT.EQ.-1)
     +      CALL ERROR('ISTFR unable to open output comment file.')
 
      CALL TRNSFR(TKNIN, CMTIN, TKNOUT, CMTOUT)
 
      CALL ZMESS('[ISTFR: Normal Termination].', 1)
      CALL ZQUIT(-2)
 
      END
C-----------------------------------------------------------
C
C  PROMPT THE USER FOR NAMES THAT HAVE NOT BEEN SUPPLIED.......
C
      SUBROUTINE NAMES (NUMB,PATH)
 
      INTEGER NUMB,PATH(*)
 
      INTEGER ZGTCMD
      INTEGER JUNK,PROMPT(22, 4)
 
      DATA (PROMPT(I,1),I=1,19)/73,110,112,117,116,32,
     +116,111,107,101,110,32,102,105,108,101,58,32,129/
     +(PROMPT(I,2),I=1,21)/73,110,112,117,116,32,99,
     +111,109,109,101,110,116,32,102,105,108,101,58,32,129/
     +(PROMPT(I,3),I=1,20)/79,117,116,112,117,116,32,
     +116,111,107,101,110,32,102,105,108,101,58,32,129/
     +(PROMPT(I,4),I=1,22)/79,117,116,112,117,116,32,
     +99,111,109,109,101,110,116,32,102,105,
     +108,101,58,32,129/
 
      CALL ZPRMPT(PROMPT(1,NUMB))
      JUNK=ZGTCMD(PATH,0)
 
      END
C-----------------------------------------------------------
C
C  TOKEN STREAM EDITOR, COPIES THE INPUT TOKEN STREAM TO THE
C  OUTPUT TOKEN STREAM CHANGING THE FORMAT OF REAL NUMBERS
C
      SUBROUTINE TRNSFR(TKNIN, CMTIN, TKNOUT, CMTOUT)
 
      INTEGER TKNIN, CMTIN, TKNOUT, CMTOUT, TKNTYP, TKNLEN,
     +        STATUS, I, J, DESCI, DESCO, POINT, SEP, PREVTK
      INTEGER TKNSTR(1322), BUFFER(1322), TEMP(134)
      INTEGER LENGTH, ZSETP, ZSETR, ZPREPL, ZTKGTI, ZTKPTI
      LOGICAL INFMT
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      PREVTK = 0
      INFMT  = .FALSE.
 
      DESCI = ZTKGTI(1, TKNIN, CMTIN)
      DESCO = ZTKPTI(1, TKNOUT, CMTOUT)
      IF(DESCI .LE. 0 .OR. DESCO .LE. 0) RETURN
 
   10 CONTINUE
        CALL ZGETTK(TKNTYP, TKNLEN, TKNSTR, DESCI, STATUS)
        IF(TKNTYP .EQ. TRCNST  .OR. TKNTYP .EQ. TPCNST) THEN
          CALL SCOPY(TKNSTR, 1, BUFFER, 1)
          IF(TKNTYP .EQ. TRCNST) THEN
            CALL DOVALX(0, BUFFER, TKNSTR, TKNLEN)
          ELSE IF(TKNTYP .EQ. TPCNST) THEN
            CALL DOVALX(1, BUFFER, TKNSTR, TKNLEN)
          ENDIF
        ENDIF
        CALL ZPUTTK(TKNTYP, TKNLEN, TKNSTR, DESCO)
      IF(TKNTYP .NE. TZEOF) GO TO 10
 
      END
C-----------------------------------------------------------------------
C
      SUBROUTINE DOVALX(TYPEX, FROM, TO, TI)
 
      INTEGER TYPEX, I, FI, TI, EAT, BIGEXP, LETEXP
      INTEGER ZLOWER, TYPE, CTOI
      INTEGER FROM(*), TO(*)
      LOGICAL UPE, DOH, DOP, DOF
      COMMON /OPTION/ UPE, DOH, DOP, DOF
      SAVE /OPTION/
 
      FI = 1
      TI = 1
      IF(TYPEX .EQ. 1) THEN
        BIGEXP = 68
        LETEXP = 100
      ELSE
        BIGEXP = 69
        LETEXP = 101
      ENDIF
C
C  WATCH FOR MANTISSA STARTING WITH A PERIOD
C
      IF(FROM(FI) .EQ. 46) THEN
        TO(TI) = 48
        TI = TI + 1
        GO TO 100
      ENDIF
C
C  COPY DIGITS OF MANTISSA PRECEEDING DECIMAL POINT
C
   10 CONTINUE
      IF(TYPE(FROM(FI)) .EQ. 2) THEN
        TO(TI) = FROM(FI)
        FI = FI + 1
        TI = TI + 1
        GO TO 10
 
      ELSE IF(FROM(FI) .EQ. 129) THEN
        TO(TI) = 46
        TO(TI+1) = 48
        TI = TI + 2
        GO TO 1000
 
      ELSE IF(FROM(FI) .EQ. 46) THEN
        GO TO 100
 
      ELSE IF(FROM(FI) .EQ. BIGEXP .OR. FROM(FI) .EQ. LETEXP) THEN
        TO(TI) = 46
        TO(TI+1) = 48
        TO(TI+2) = BIGEXP
        EAT = TI+2
        FI = FI + 1
        TI = TI + 3
        GO TO 200
 
      ENDIF
C
C  DIGITS FOLLOWING DECIMAL POINT
C
  100 CONTINUE
      TO(TI) = 46
      FI = FI + 1
      TI = TI + 1
 
   20 CONTINUE
      IF(TYPE(FROM(FI)) .EQ. 2) THEN
        TO(TI) = FROM(FI)
        FI = FI + 1
        TI = TI + 1
        GO TO 20
 
      ELSE IF(FROM(FI) .EQ. 129) THEN
        IF(TO(TI-1) .EQ. 46) THEN
          TO(TI) = 48
          TI = TI + 1
        ENDIF
        GO TO 1000
 
      ELSE IF(FROM(FI) .EQ. BIGEXP .OR. FROM(FI) .EQ. LETEXP) THEN
        IF(TO(TI-1) .EQ. 46) THEN
          TO(TI) = 48
          TI = TI + 1
        ENDIF
        TO(TI) = BIGEXP
        EAT = TI
        FI = FI + 1
        TI = TI + 1
        GO TO 200
 
      ENDIF
C
C  HANDLE EXPONENT PART - OPTIONAL SIGN FIRST, DELETE IT IF THERE
C  IS A ZERO EXPONENT (NOT FOR DOUBLE!!).....
C
  200 CONTINUE
      IF(FROM(FI) .EQ. 45) THEN
        TO(TI) = 45
        FI = FI + 1
        TI = TI + 1
      ELSE IF(FROM(FI) .EQ. 43) THEN
        FI = FI + 1
      ENDIF
      I = FI
      IF(CTOI(FROM, I) .EQ. 0 .AND. TYPEX .NE. 1) THEN
        TI = EAT
 
      ELSE
   30   CONTINUE
        IF(FROM(FI) .NE. 129) THEN
          TO(TI) = FROM(FI)
          FI = FI + 1
          TI = TI + 1
          GO TO 30
        ENDIF
      ENDIF
C
C  FINISH OFF THE STRING
C
 1000 CONTINUE
      TO(TI) = 129
      TI = TI - 1
 
      END
